Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH11/SRC/OBJPGON1.CLS

Text File | 1996-05-04 | 8KB | 303 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjPolygon"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

' Point3D is defined in module M3OPS.BAS as:
'    Type Point3D
'        coord(1 To 4) As Single
'        trans(1 To 4) As Single
'    End Type

Private NumPts As Integer ' Number of points.
Private Points() As Point3D  ' Data points.

Private IsCulled As Boolean





' ***********************************************
' Create a polyline representing the normal to
' this polygon and place it in the given objects
' collection.
' ***********************************************
Sub CreateNormal(Objects As Collection)
Dim pline As New ObjPolyline
Dim x1 As Single
Dim y1 As Single
Dim z1 As Single
Dim x2 As Single
Dim y2 As Single
Dim z2 As Single

    Objects.Add pline
    UnitNormalSegment x1, y1, z1, x2, y2, z2
    pline.AddSegment x1, y1, z1, x2, y2, z2
End Sub


' ***********************************************
' Compute a normal vector for this polygon.
' ***********************************************
Public Sub NormalVector(nx As Single, ny As Single, nz As Single)
Dim Ax As Single
Dim Ay As Single
Dim Az As Single
Dim Bx As Single
Dim By As Single
Dim Bz As Single

    Ax = Points(2).coord(1) - Points(1).coord(1)
    Ay = Points(2).coord(2) - Points(1).coord(2)
    Az = Points(2).coord(3) - Points(1).coord(3)
    Bx = Points(3).coord(1) - Points(2).coord(1)
    By = Points(3).coord(2) - Points(2).coord(2)
    Bz = Points(3).coord(3) - Points(2).coord(3)
    m3Cross nx, ny, nz, Ax, Ay, Az, Bx, By, Bz
End Sub




' ***********************************************
' Compute the unit normal line segment for this
' polygon.
' ***********************************************
Sub UnitNormalSegment(x1 As Single, y1 As Single, z1 As Single, x2 As Single, y2 As Single, z2 As Single)
Dim i As Integer
Dim nx As Single
Dim ny As Single
Dim nz As Single

    UnitNormalVector nx, ny, nz

    x1 = 0
    y1 = 0
    z1 = 0
    For i = 1 To NumPts
        x1 = x1 + Points(i).coord(1)
        y1 = y1 + Points(i).coord(2)
        z1 = z1 + Points(i).coord(3)
    Next i
    x1 = x1 / NumPts
    y1 = y1 / NumPts
    z1 = z1 / NumPts

    x2 = x1 + nx
    y2 = y1 + ny
    z2 = z1 + nz
End Sub


' ***********************************************
' Compute the unit normal vector for this
' polygon.
' ***********************************************
Sub UnitNormalVector(nx As Single, ny As Single, nz As Single)
Dim D As Single

    NormalVector nx, ny, nz
    D = Sqr(nx * nx + ny * ny + nz * nz)
    nx = nx / D
    ny = ny / D
    nz = nz / D
End Sub





' ***********************************************
' Set or clear the IsCulled flag.
' ***********************************************
Property Let Culled(value As Boolean)
    IsCulled = value
End Property


' ***********************************************
' Return true if the polygon has been culled.
' ***********************************************
Property Get Culled() As Boolean
    Culled = IsCulled
End Property

' ***********************************************
' Return a string indicating the object type.
' ***********************************************
Property Get ObjectType() As String
    ObjectType = "POLYGON"
End Property

' ************************************************
' Add one or more points to the polygon.
' ************************************************
Public Sub AddPoint(ParamArray coord() As Variant)
Dim num_pts As Integer
Dim i As Integer
Dim pt As Integer

    num_pts = (UBound(coord) + 1) \ 3
    ReDim Preserve Points(1 To NumPts + num_pts)

    pt = 0
    For i = 1 To num_pts
        Points(NumPts + i).coord(1) = coord(pt)
        Points(NumPts + i).coord(2) = coord(pt + 1)
        Points(NumPts + i).coord(3) = coord(pt + 2)
        Points(NumPts + i).coord(4) = 1#
        pt = pt + 3
    Next i

    NumPts = NumPts + num_pts
End Sub

' ***********************************************
' Fix the data coordinates at their transformed
' values.
' ***********************************************
Public Sub FixPoints()
Dim i As Integer
Dim j As Integer

    For i = 1 To NumPts
        For j = 1 To 3
            Points(i).coord(j) = Points(i).trans(j)
        Next j
    Next i
End Sub

' ************************************************
' Apply a transformation matrix which may not
' contain 0, 0, 0, 1 in the last column to the
' object.
' ************************************************
Public Sub ApplyFull(M() As Single)
Dim i As Integer

    If IsCulled Then Exit Sub
    For i = 1 To NumPts
        m3ApplyFull Points(i).coord, M, Points(i).trans
    Next i
End Sub

' ************************************************
' Apply a transformation matrix to the object.
' ************************************************
Public Sub Apply(M() As Single)
Dim i As Integer

    If IsCulled Then Exit Sub
    For i = 1 To NumPts
        m3Apply Points(i).coord, M, Points(i).trans
    Next i
End Sub


' ************************************************
' Apply a nonlinear transformation.
' ************************************************
Public Sub Distort(D As Object)
Dim i As Integer

    For i = 1 To NumPts
        D.Distort Points(i).coord(1), Points(i).coord(2), Points(i).coord(3)
    Next i
End Sub

' ************************************************
' Write a polyline to a file using Write.
' Begin with "POLYGON" to identify this object.
' ************************************************
Public Sub FileWrite(filenum As Integer)
Dim i As Integer

    Write #filenum, "POLYGON", NumPts

    ' Write the points.
    For i = 1 To NumPts
        Write #filenum, Points(i).coord(1), Points(i).coord(2), Points(i).coord(3)
    Next i
End Sub

' ************************************************
' Draw the transformed points on a Form, Printer,
' or PictureBox.
' ************************************************
Public Sub Draw(canvas As Object, Optional r As Variant)
Dim pt As Integer

    ' Don't draw if culled.
    If IsCulled Then Exit Sub

    On Error Resume Next
    canvas.CurrentX = Points(NumPts).trans(1)
    canvas.CurrentY = Points(NumPts).trans(2)
    For pt = 1 To NumPts
        canvas.Line _
            -(Points(pt).trans(1), Points(pt).trans(2))
    Next pt
End Sub
' ***********************************************
' Cull if any points are behind the center of
' projection.
' ***********************************************
Public Sub ClipEye(r As Single)
Dim pt As Integer

    If IsCulled Then Exit Sub
    For pt = 1 To NumPts
        If Points(pt).trans(3) >= r Then Exit For
    Next pt
    If pt <= NumPts Then IsCulled = True
End Sub
' ***********************************************
' Perform backface removal.
' ***********************************************
Public Sub Cull(X As Single, Y As Single, z As Single)
Dim Ax As Single
Dim Ay As Single
Dim Az As Single
Dim nx As Single
Dim ny As Single
Dim nz As Single

    ' Compute a normal to the face.
    NormalVector nx, ny, nz

    ' Compute a vector from the center of
    ' projection to the face.
    Ax = Points(1).coord(1) - X
    Ay = Points(1).coord(2) - Y
    Az = Points(1).coord(3) - z

    ' See if the vectors meet at an angle < 90.
    IsCulled = (Ax * nx + Ay * ny + Az * nz > -0.0001)
End Sub

' ************************************************
' Read a polyline from a file using Input.
' Assume the "POLYGON" label has already been
' read.
' ************************************************
Public Sub FileInput(filenum As Integer)
Dim i As Integer

    Input #filenum, NumPts

    ' Allocate and read the points.
    ReDim Points(1 To NumPts)
    For i = 1 To NumPts
        Input #filenum, Points(i).coord(1), Points(i).coord(2), Points(i).coord(3)
        Points(i).coord(4) = 1#
    Next i
End Sub